perm filename GOEVAL.SAI[GO,ALS] blob
sn#105686 filedate 1974-06-12 generic text, type T, neo UTF8
00100 ENTRY GOEVAL;
00200 BEGIN "GOEVAL"
00300
00400
00500
00600
00700
00800 DEFINE LSTO="5",CRLF="('15&'12)",TAB="'11",TT="1",LPT="2",
00900 CRLF3="(CRLF&CRLF&CRLF)",FF="(CRLF&'14)";
01000
01100 EXTERNAL INTEGER TTYGUY,MOVENO,GAMVAL,OUTPON,BOARDS,MOVETIME,IIIDPY;
01200 EXTERNAL INTEGER NDXFOR,PFORCE,IFORCE,JFORCE,IFOR,JFOR,KFOR;
01300 EXTERNAL INTEGER BKFLAG,EXMOVE,STRRST,NODANS;
01400
01500 EXTERNAL INTEGER ARRAY ARMIES,WALLS,XGRPPT[-3:99],XGB2[0:442],XSTRPT[0:255],
01600 XGB3,XGB1,XGBOAR[0:440],PNTDPY[0:499],MSGDPY[0:49],BRDDPY[0:99];
01700
01800 INTERNAL INTEGER LVL,SENTE,ISEN,JSEN,I,SF,SE,PLAYER,ISAV,JSAV,
01900 KKK,LEXIST,CURI,CURJ,KLLR,SAVR,HEURBT,HEURB1,HEURB2,HEURB3;
02000
02100 INTEGER K,L,IJ,J,OLDF,M,A3,NEWF,KLADR,MOVNDX,DUPFLG,CURPNT,OUTPOF,
02200 STOPHI,STOPLO,DANGERSTONES,FORCECOUNT,MOVND1;
02300
02400 INTERNAL INTEGER ARRAY INFLTB[0:49],BLSAVE,WHSAVE,ADJWGT,
02500 DIFWGT,FRDWGT,ENMWGT,BLDATA,WHDATA,MSCVAL[0:35],LBONUS[0:17],
02600 SCRFRV,SCRENV[0:16],MSCWGT,KLLWGT,LIVWGT[0:35],
02700 KILSAV[0:39];
02800
02900 EXTERNAL STRING FSSTRG;
03000
03100
03200 EXTERNAL PROCEDURE AREA;
03300 EXTERNAL PROCEDURE KWAREA;
03400 EXTERNAL PROCEDURE LADRST;
03500 EXTERNAL PROCEDURE ENDANG;
03600 EXTERNAL PROCEDURE FORCES(INTEGER BASEPT);
03700 EXTERNAL PROCEDURE SAVES(INTEGER BASEPT);
03800 EXTERNAL INTEGER PROCEDURE LEGAL1(INTEGER BASEPT);
03900 EXTERNAL INTEGER PROCEDURE LEGAL2(INTEGER BASEPT);
04000 EXTERNAL INTEGER PROCEDURE NGHBOR(INTEGER STRNO);
04100 EXTERNAL INTEGER PROCEDURE NGHBR1;
04200 EXTERNAL PROCEDURE UNMOV1;
04300 EXTERNAL INTEGER PROCEDURE NOMOVE(INTEGER I,J,MVNO);
04400 EXTERNAL PROCEDURE UNTAC1;
04500 EXTERNAL INTEGER PROCEDURE LEGAL(INTEGER I,J,MVNO);
04600 EXTERNAL PROCEDURE UNMOVE;
04700 EXTERNAL PROCEDURE AWUPDA;
04800 EXTERNAL PROCEDURE SCRUPD;
04900 EXTERNAL PROCEDURE SCOSET;
05000 EXTERNAL INTEGER PROCEDURE GBFGET(INTEGER INDEX);
05100 EXTERNAL INTEGER PROCEDURE GBEGET(INTEGER NDX);
05200 EXTERNAL INTEGER PROCEDURE INFLPT(INTEGER NDX);
05300 EXTERNAL PROCEDURE GBFPUT(INTEGER VALU,INDEX);
05400 EXTERNAL PROCEDURE GBEPUT(INTEGER VALU,INDEX);
05500 EXTERNAL PROCEDURE KILLIV;
05600 EXTERNAL PROCEDURE BRDOUT;
05700 EXTERNAL PROCEDURE VALOUT(INTEGER NBR);
05800 EXTERNAL STRING PROCEDURE BLIJ(INTEGER I,J);
05900 EXTERNAL PROCEDURE HEDOUT(INTEGER DEVCE);
06000 EXTERNAL INTEGER PROCEDURE TACEVL(INTEGER PLAYER,NDX; INTEGER ARRAY ARRY);
06100 EXTERNAL PROCEDURE KWIKAR;
06200 EXTERNAL PROCEDURE KWIKWL;
06300 EXTERNAL INTEGER PROCEDURE LINE4(INTEGER I,J,WGT);
06400
06500
06600
06700
06800
06900 INTERNAL PROCEDURE CONSET;
07000 BEGIN COMMENT
07100 *************DEFINE INFLUENCE FUNCTION*****;
07200
07300 K←0;
07400 FOR I←-3 STEP 1 UNTIL 3 DO
07500 FOR J←-3 STEP 1 UNTIL 3 DO BEGIN
07600 IF (L←ABS(I))+(M←ABS(J))≤3 THEN
07700 CASE L OF BEGIN
07800 INFLTB[K]←MSCVAL[CASE M OF (29,28,26,24)] LSH 18;
07900 INFLTB[K]←MSCVAL[CASE M OF (28,27,25)] LSH 18;
08000 INFLTB[K]←MSCVAL[CASE M OF (26,25)] LSH 18;
08100 INFLTB[K]←MSCVAL[24] LSH 18;
08200 END
08300 ELSE IF L=M=2 THEN INFLTB[K]←MSCVAL[24] LSH 18
08400 ELSE INFLTB[K]←0;
08500 K←K+1;
08600 END;
08700 INFLTB[K]←0;
08800 END; COMMENT CONSET;
08900
09000
09100 PROCEDURE FSIN(STRING FS);
09200 BEGIN
09300 OUT(LSTO,FSSTRG[1 TO (NDXFOR DIV 5)]); OUT(LSTO,FS);
09400 IF ABS(KFOR)≠1 THEN BEGIN
09500 OUT(LSTO,BLIJ(IFORCE DIV 21,IFORCE MOD 21));
09600 OUT(LSTO,TAB&"***"); IF NDXFOR>5 THEN IFORCE←0;
09700 END ELSE IF IFORCE THEN BEGIN
09800 OUT(LSTO,BLIJ(IFORCE DIV 21,IFORCE MOD 21)); OUT(LSTO," ");
09900 OUT(LSTO,CVOS(HEURBT));
10000 IF JFORCE THEN BEGIN
10100 OUT(LSTO," "); OUT(LSTO,BLIJ(JFORCE DIV 21,JFORCE MOD 21));
10200 OUT(LSTO," "); OUT(LSTO,CVOS(HEURB1));
10300 IF IFOR THEN BEGIN
10400 OUT(LSTO," "); OUT(LSTO,BLIJ(IFOR DIV 21,IFOR MOD 21));
10500 OUT(LSTO," "); OUT(LSTO,CVOS(HEURB2));
10600 IF JFOR THEN BEGIN
10700 OUT(LSTO," ");
10800 OUT(LSTO,BLIJ(JFOR DIV 21,JFOR MOD 21));
10900 OUT(LSTO," "); OUT(LSTO,CVOS(HEURB3));
11000 END;
11100 END;
11200 END;
11300 END ELSE OUT(LSTO,TAB&"***");
11400 OUT(LSTO,CRLF);
11500 END;
11600
11700 PROCEDURE FSOUT(STRING FS);
11800 BEGIN
11900 OUT(LSTO,FSSTRG[1 TO ((NDXFOR DIV 5)+1)]); OUT(LSTO,FS);
12000 OUT(LSTO,"***"); OUT(LSTO,CVS(KFOR)); OUT(LSTO,CRLF);
12100 END;
12200 PROCEDURE HEDLAD;
12300 BEGIN
12400 OUT(LSTO,CRLF3&"TARGET AT ");
12500 OUT(LSTO,BLIJ(PFORCE DIV 21,PFORCE MOD 21));
12600 OUT(LSTO,TAB); HEDOUT(LSTO); OUT(LSTO,CRLF3);
12700 END;
12800 PROCEDURE LADRES(INTEGER STR,VAL);
12900 BEGIN
13000 OUT(LSTO,"STRING AT"); OUT(LSTO,BLIJ(PFORCE DIV 21,PFORCE MOD 21));
13100 OUT(LSTO,TAB&"# "); OUT(LSTO,CVS(STR)); OUT(LSTO,TAB&"BONUS = ");
13200 OUT(LSTO,CVS(VAL)); OUT(LSTO,TAB&TAB&"EXCHANGE AT ");
13300 OUT(LSTO,BLIJ(EXMOVE DIV 21,EXMOVE MOD 21)); OUT(LSTO,CRLF);
13400 END;
00100 INTERNAL INTEGER PROCEDURE STRATEVAL(INTEGER NDX,PLAYER,ISRT,ISTP);
00200 BEGIN COMMENT
00300 **********
00400 SCORE THE CURRENT STRATEGIC DATA IN TERMS OF DIFFERENCE
00500 BETWEEN THE TWO PLAYERS OR IN TERMS OF THE DEVELOPMENT OF ONE
00600 OF THE PLAYERS. NOTE MORE THAN ONE POLY CAN BE DONE AT A TIME.
00700 **********;
00800 INTEGER IJ,K;
00900 IJ←0;
01000 IF NDX LAND 2 THEN
01100 FOR K←ISRT STEP 1 UNTIL ISTP DO
01200 IJ←IJ+DIFWGT[K]*(BLDATA[K]-WHDATA[K]);
01300 IF NDX LAND 4 THEN
01400 FOR K←ISRT STEP 1 UNTIL ISTP DO
01500 IJ←IJ+FRDWGT[K]*(BLDATA[K]-WHDATA[K]);
01600 IF NDX LAND 8 THEN
01700 FOR K←ISRT STEP 1 UNTIL ISTP DO
01800 IJ←IJ+ENMWGT[K]*(BLDATA[K]-WHDATA[K]);
01900 IF PLAYER THEN BEGIN
02000 IF NDX LAND 16 THEN
02100 FOR K←ISRT STEP 1 UNTIL ISTP DO
02200 IJ←IJ+ADJWGT[K]*(BLDATA[K]-BLSAVE[K]);
02300 END ELSE BEGIN IJ←-IJ;
02400 IF NDX LAND 16 THEN
02500 FOR K←ISRT STEP 1 UNTIL ISTP DO
02600 IJ←IJ+ADJWGT[K]*(WHDATA[K]-WHSAVE[K]);
02700 END;
02800 RETURN(IJ);
02900 END;
03000
03100
03200
03300
03400
03500 FORWARD INTEGER PROCEDURE FORCER;
03600
03700
03800 INTEGER PROCEDURE SAVER;
03900 BEGIN COMMENT
04000 **********
04100 INITIATE A SAVING SEQUENCE AGAINST STRING WHICH OCCUPIES POINT
04200 PFORCE. IF KFOR<0 THEN THE SEQUENCE WAS (EVENTUALLY) SUCCESSFUL
04300 **********;
04400 LABEL NOMORS;
04500 ARRBLT(PNTDPY[NDXFOR],IFORCE,5); NDXFOR←NDXFOR+5;
04600 IF FORCECOUNT>MSCVAL[6] THEN BEGIN
04700 KFOR←-999; GO TO NOMORS;
04800 END;
04900 DUPFLG←1; SAVES(PFORCE);
05000 IF OUTPOF THEN FSIN((IF BKFLAG THEN "s" ELSE "S"));
05100 IF KFOR<0 THEN GO TO NOMORS ELSE DUPFLG←0;
05200 IF LEGAL2(IFORCE) THEN IFORCE←0
05300 ELSE IF (KFOR←FORCER)<0 THEN BEGIN
05400 IF NDXFOR=5 THEN MOVNDX←IFORCE;
05500 DUPFLG←1; GO TO NOMORS;
05600 END;
05700 IF DUPFLG THEN DUPFLG←0;
05800 IF LEGAL2(JFORCE) THEN JFORCE←0
05900 ELSE IF (KFOR←FORCER)<0 THEN BEGIN
06000 IF NDXFOR=5 THEN MOVNDX←JFORCE; GO TO NOMORS;
06100 END;
06200 IF LEGAL2(IFOR) THEN IFOR←0
06300 ELSE IF (KFOR←FORCER)<0 THEN BEGIN
06400 IF NDXFOR=5 THEN MOVNDX←IFOR; GO TO NOMORS;
06500 END;
06600 IF LEGAL2(JFOR) THEN JFOR←0 ELSE KFOR←FORCER;
06700 IF (KFOR<0)∧(NDXFOR=5) THEN MOVNDX←JFOR;
06800 NOMORS:NDXFOR←NDXFOR-5; KLADR←KFOR;
06900 IF NDXFOR THEN UNMOV1;
07000 IF OUTPOF THEN FSOUT("S");
07100 ARRBLT(IFORCE,PNTDPY[NDXFOR],5);
07200 RETURN(KLADR);
07300 END;
07400
07500
07600
07700
07800
07900 INTEGER PROCEDURE FORCER;
08000 BEGIN COMMENT
08100 **********
08200 INITIATE A FORCED SEQUENCE AGAINST STRING WHICH OCCUPIES POINT
08300 PFORCE. IF KFOR>0 THEN THE SEQUENCE WAS (EVENTUALLY) SUCCESSFUL
08400 **********;
08500 LABEL NOMORF;
08600 ARRBLT(PNTDPY[NDXFOR],IFORCE,5); NDXFOR←NDXFOR+5;
08700 IF (FORCECOUNT←FORCECOUNT+1)>MSCVAL[6] THEN BEGIN
08800 IF (OUTPON LAND '44000)∧(FORCECOUNT=(MSCVAL[6]+1)) THEN
08900 BEGIN
09000 OUT(LSTO,CRLF3&"********** WANDERING ANALYSIS **********"
09100 &CRLF);
09200 OUT(LSTO,"TARGET AT");
09300 OUT(LSTO,BLIJ(PFORCE DIV 21,PFORCE MOD 21));
09400 OUT(LSTO,TAB); HEDOUT(LSTO); OUT(LSTO,CRLF3);
09500 END;
09600 KFOR←-999; GO TO NOMORF;
09700 END;
09800 DUPFLG←1; FORCES(PFORCE);
09900 IF OUTPOF THEN FSIN((IF BKFLAG THEN "f" ELSE "F"));
10000 IF KFOR<0 THEN BEGIN
10100 DUPFLG←0;
10200 IF LEGAL1(IFORCE) THEN IFORCE←0
10300 ELSE IF (KFOR←SAVER)>0 THEN BEGIN
10400 IF NDXFOR=5 THEN BEGIN MOVNDX←IFORCE;
10500 MOVND1←JFORCE; END;
10600 DUPFLG←1; GO TO NOMORF;
10700 END;
10800 IF DUPFLG THEN DUPFLG←0;
10900 IF LEGAL1(JFORCE) THEN JFORCE←0
11000 ELSE IF (KFOR←SAVER)>0 THEN BEGIN
11100 IF NDXFOR=5 THEN MOVNDX←JFORCE; GO TO NOMORF;
11200 END;
11300 IF LEGAL1(IFOR) THEN IFOR←0
11400 ELSE IF (KFOR←SAVER)>0 THEN BEGIN
11500 IF NDXFOR=5 THEN MOVNDX←IFOR; GO TO NOMORF;
11600 END;
11700 IF LEGAL1(JFOR) THEN JFOR←0 ELSE KFOR←SAVER;
11800 IF (KFOR>0)∧(NDXFOR=5) THEN MOVNDX←JFOR;
11900 END ELSE BEGIN
12000 IF NDXFOR=5 THEN BEGIN MOVNDX←IFORCE; MOVND1←JFORCE; END;
12100 END;
12200 NOMORF:NDXFOR←NDXFOR-5; KLADR←KFOR;
12300 IF NDXFOR THEN UNMOV1;
12400 IF OUTPOF THEN FSOUT("F");
12500 ARRBLT(IFORCE,PNTDPY[NDXFOR],5);
12600 RETURN(KLADR);
12700 END;
12800
12900
13000
13100
13200
13300 INTEGER PROCEDURE LADEVAL(INTEGER LNDX,BONUS;INTEGER ARRAY BRDMSG);
13400 BEGIN COMMENT
13500 **********
13600 EVALUATE THE POTENTIAL FORCING AND SAVING SEQUENCES FOR EACH OF
13700 THE STRINGS IN THE SPECFIED ARRAY. LNDX=0 AND MSGDPY MEANS
13800 ENEMY STRINGS WHILE LNDX=9 AND BRDDPY MEANS FRIENDLY STRINGS.
13900 **********;
14000 INTEGER K,KNT,NEWF,OLDF,VALF,TEMPN,CONTGT,TARGET;
14100
14200 PROCEDURE FIXKNT(INTEGER FIXIT);
14300 BEGIN
14400 KNT←KNT-MSCWGT[FIXIT];
14500 IF XGB3[CURPNT] LAND '200000 THEN KNT←KNT-LIVWGT[FIXIT];
14600 IF XGB3[CURPNT] LAND '200000000000 THEN KNT←KNT-KLLWGT[FIXIT];
14700 END;
14800
14900 K←KNT←NDXFOR←0;
15000 WHILE (TARGET←BRDMSG[K]) DO BEGIN
15100 LABEL SKIPIT;
15200 IF (TEMPN←(TARGET LAND '777777000000)) THEN BEGIN
15300 IF TEMPN='4000000 THEN BEGIN
15400 TARGET←TARGET LAND '177; CONTGT←-1;
15500 END ELSE BEGIN
15600 BRDMSG[K]←TARGET LAND '1777777; GO TO SKIPIT;
15700 END;
15800 END ELSE CONTGT←0;
15900 OLDF←LNDX+(IF XSTRPT[TARGET] LAND '2000000000 THEN 3
16000 ELSE IF XSTRPT[TARGET] LAND '1000000000 THEN 6 ELSE 0);
16100 IF (PFORCE←((XSTRPT[TARGET] LSH -18) LAND '777))=0 THEN BEGIN
16200 IF CURPNT=PFORCE THEN KNT←KNT-LBONUS[OLDF+2];
16300 GO TO SKIPIT;
16400 END;
16500 IF OUTPOF THEN HEDLAD; FORCECOUNT←PNTDPY[5]←0; VALF←FORCER;
16600 IF (VALF<0)∧((LNDX=0)∨(FORCECOUNT<MSCVAL[6])) THEN NEWF←OLDF
16700 ELSE BEGIN
16800 IF EXMOVE∨K∨(LNDX=0)∨(OLDF=12) THEN BEGIN
16900 FORCECOUNT←PNTDPY[5]←0;
17000 IF OUTPOF THEN HEDLAD; VALF←SAVER;
17100 END ELSE VALF←-99;
17200 COMMENT DONT CALCULATE THE DIFFERENCE BETWEEN
17300 ENDANGERED→ENDANGERED AND ENDANGERED→DEAD FOR CURRENT STRING;
17400 NEWF←OLDF+(IF VALF<0 THEN 2 ELSE 1);
17500 IF (PFORCE=CURPNT)∧(XGB3[PFORCE] LAND '10000)∧
17600 ((FORCECOUNT+10)<MSCVAL[6]) THEN FIXKNT(23);
17700 END;
17800 TEMPN←NEWF-LNDX; OLDF←LBONUS[NEWF];
17900 IF OLDF THEN BEGIN
18000 VALF←(IF PFORCE=CURPNT THEN DANGERSTONES ELSE
18100 ((XSTRPT[TARGET] LSH -9) LAND '777))*BONUS;
18200 IF CONTGT∧((NEWF MOD 3)≠0) THEN OLDF←OLDF+MSCVAL[8];
18300 IF EXMOVE∧((TEMPN=2)∨(TEMPN=5)∨(TEMPN=6)∨(TEMPN=8))
18400 THEN OLDF←OLDF+MSCVAL[7];
18500 OLDF←OLDF+(IF OLDF<0 THEN -VALF ELSE VALF);
18600 IF XSTRPT[TARGET] LAND '4000000000 THEN BEGIN
18700 IF (LNDX=0)∧((NEWF MOD 3)≠0)∧(XGB3[CURPNT] LAND '400000)
18800 THEN FIXKNT(18);
18900 OLDF←OLDF+MSCVAL[5];
19000 END;
19100 KNT←KNT+OLDF;
19200 END;
19300 IF OUTPON LAND '44000 THEN LADRES(TARGET,OLDF);
19400 IF (NEWF-LNDX) MOD 4 THEN TARGET←TARGET LOR '2000000;
19500 BRDMSG[K]←TARGET LOR '1000000;
19600 SKIPIT: K←K+1;
19700 END;
19800 RETURN(KNT)
19900 END;
20000
20100
20200
20300
20400
20500 INTERNAL PROCEDURE LADDERSET(INTEGER STRNGNO);
20600 BEGIN COMMENT
20700 **********
20800 CHECK OVER THE WHOLE BOARD POSITION WITH RESPECT TO LADDER
20900 POSSIBILITIES. MARK THE BASE GBOARD POINT OF EACH STRING
21000 "DEAD", "ENDANGERED" OR "OK" (NO MARK). KILSAV[0:19] HOLDS
21100 MOVES WHICH KILL ENDANGERED STRINGS, WHILE KILSAV[20:39] HOLDS
21200 MOVES WHICH SAVE ENDANGERED STRINGS.
21300 **********;
21400 INTEGER KIL1,STRLBS,IIISAV,KIL2; LABEL ENDIT;
21500 KIL1←KLLR←NDXFOR←0; IIISAV←IIIDPY; IIIDPY←0;
21600 WHILE (STRLBS←KILSAV[KIL1] LSH -18) DO BEGIN
21700 IF (XSTRPT[STRLBS+128] LAND '200000000)=0 THEN BEGIN
21800 KILSAV[KLLR]←KILSAV[KIL1]; KLLR←KLLR+1;
21900 END;
22000 KIL1←KIL1+1;
22100 END;
22200 KIL1←SAVR←20;
22300 WHILE (STRLBS←KILSAV[KIL1] LSH -18) DO BEGIN
22400 IF (XSTRPT[STRLBS+128] LAND '200000000)=0 THEN BEGIN
22500 KILSAV[SAVR]←KILSAV[KIL1]; SAVR←SAVR+1;
22600 END;
22700 KIL1←KIL1+1;
22800 END;
22900 STRRST←-1; COMMENT TACTICAL SCOPES ARE DEFINED HERE;
23000 IF (OUTPOF←(OUTPON LAND '40000)) THEN OUT(LSTO,FF&FF);
23100 FOR STRLBS←1,2,0 DO BEGIN
23200 FOR K←1 STEP 1 UNTIL 126 DO BEGIN
23300 LABEL TRYNXT;
23400 IF STRNGNO THEN K←STRNGNO;
23500 IF PFORCE←((XSTRPT[K] LSH -18) LAND '777) THEN BEGIN
23600 IF K=STRNGNO THEN
23700 XSTRPT[K+128]←XSTRPT[K+128] LOR '200000000
23800 ELSE
23900 IF STRLBS THEN BEGIN
24000 IF STRLBS≠(XSTRPT[K] LAND '777) THEN GO TO TRYNXT;
24100 END ELSE BEGIN
24200 IF (XSTRPT[K] LAND '777)≤2 THEN GO TO TRYNXT;
24300 END;
24400 IF OUTPOF THEN HEDLAD;
24500 IF (XSTRPT[K+128] LAND '200000000)=0 THEN BEGIN
24600 IF OUTPOF THEN
24700 OUT(LSTO,"*********UNAFFECTED STRING"&CRLF);
24800 GO TO TRYNXT;
24900 END;
25000 MOVNDX←FORCECOUNT←KIL2←0; MOVND1←-1;
25100 XSTRPT[K]←XSTRPT[K] LAND '774777777777;
25200 IF (FORCER>0)∨(FORCECOUNT≥MSCVAL[6]) THEN BEGIN
25300 IF MOVNDX∧(KLLR<20)∧(FORCECOUNT<MSCVAL[6]) THEN BEGIN
25400 KILSAV[KLLR]←(K LSH 18)+MOVNDX; KIL1←KLLR←KLLR+1;
25500 END ELSE KIL1←0;
25600 IF OUTPOF THEN HEDLAD;
25700 KIL2←FORCECOUNT; MOVNDX←FORCECOUNT←0;
25800 IF SAVER<0 THEN BEGIN
25900 IF (SAVR<40)∧(KIL2<MSCVAL[6])∧(FORCECOUNT<MSCVAL[6])
26000 THEN
26100 BEGIN
26200 IF MOVNDX THEN BEGIN
26300 KILSAV[SAVR]←(K LSH 18)+MOVNDX;
26400 SAVR←SAVR+1;
26500 END
26600 ELSE
26700 IF MOVND1=0 THEN BEGIN
26800 KILSAV[SAVR]←KILSAV[KLLR-1];
26900 SAVR←SAVR+1;
27000 END; COMMENT MOVND1=0 MEANS FORCER WAS FORCED;
27100 END;
27200 MOVNDX←'1000000000;
27300 END ELSE BEGIN
27400 IF KIL1 THEN KLLR←KLLR-1;
27500 MOVNDX←'2000000000;
27600 END;
27700 XSTRPT[K]←XSTRPT[K] LOR MOVNDX;
27800 END;
27900 LADRST; COMMENT FIX STATUS OF ALL STONES IN STRING;
28000 SCOSET; COMMENT SET TACTICAL ANALYSIS SCOPE;
28100 IF (FORCECOUNT+KIL2)<3 THEN
28200 XSTRPT[K+128]←XSTRPT[K+128] LOR '200000000;
28300 END;
28400 TRYNXT:IF K=STRNGNO THEN GO TO ENDIT;
28500 END;
28600 END;
28700 ENDIT:IF OUTPOF THEN OUT(LSTO,FF&FF);
28800 KILSAV[KLLR]←KILSAV[SAVR]←0; IIIDPY←IIISAV; STRRST←0;
28900 END;
29000
29100
29200
29300
29400
29500 INTERNAL PROCEDURE UPDAT;
29600 BEGIN COMMENT
29700 **********
29800 ALL BOARD POINTS ARE EVALUATED WITH RESPECT TO VARIOUS TACTICAL
29900 MEASURES. THE MEASURES ARE SAVED AS BITS (ONE PER MEASURE) IN
30000 THE ARRAY XGB3. THE VALUE ACCORDING TO THE CONSTANTS IN MSCWGT
30100 IS ENTERED INTO THE BITS 0-17 OF ARRAY XGB2. THIS QUANTITY IS
30200 THE "BASIC" VALUE OF A MOVE AT THE CORRESPONDING POINT.
30300 **********;
30400 INTEGER IIISAV,EXMOV1,II;
30500 MOVETIME←CALL(0,"RUNTIM");
30600 BOARDS←0; COMMENT INITIATE MOVES COUNT;
30700 FOR I←0 STEP 1 UNTIL 440 DO BEGIN
30800 XGB2[I]←XGB3[I]←0; XGBOAR[I]←XGBOAR[I] LAND '777777773777;
30900 END;
31000 LADDERSET(0); AWUPDA;
31100 IIISAV←IIIDPY; IIIDPY←0; COMMENT SHUT OFF III DISPLAY UPDATE;
31200 BRDDPY[0]←0; COMMENT NOMOVE USES THIS ARRAY;
31300 FOR I←1 STEP 1 UNTIL 19 DO
31400 FOR J←1 STEP 1 UNTIL 19 DO BEGIN
31500 IJ←21*I+J;
31600 IF (K←NOMOVE(I,J,TTYGUY))=0 THEN UNTAC1;
31700 IF (L←NOMOVE(I,J,1-TTYGUY))=0 THEN UNTAC1;
31800 IF L∨(XGBOAR[IJ] LAND '4000) THEN XGB3[IJ]←-1;
31900 IF K THEN XGB3[IJ]←XGB3[IJ] LOR '40000000;
32000 END;
32100 AREA; ENDANG;
32200 FOR I←0 STEP 1 UNTIL 440 DO XGB2[I]←0; KILLIV;
32300 ARRBLT(WHSAVE[0],WHDATA[0],35); ARRBLT(BLSAVE[0],BLDATA[0],35);
32400 FOR I←1 STEP 1 UNTIL 19 DO
32500 FOR J←1 STEP 1 UNTIL 19 DO BEGIN
32600 IJ←21*I+J;
32700 IF (K←LINE4(I,J,MSCVAL[23]))<'400000 THEN BEGIN
32800 K←K+TACEVL(1-TTYGUY,IJ,MSCWGT);
32900 IF XGB3[IJ] LAND '200000 THEN
33000 K←K+TACEVL(1-TTYGUY,IJ,LIVWGT);
33100 IF XGB3[IJ] LAND '200000000000 THEN
33200 K←K+TACEVL(1-TTYGUY,IJ,KLLWGT);
33300 GBEPUT(K+(GBFGET(IJ) LAND '777)
33400 *MSCVAL[34]+(GBFGET(IJ) LSH -9)*MSCVAL[35],IJ);
33500 END ELSE GBEPUT(-100000,IJ);
33600 GBFPUT(-100000,IJ);
33700 END;
33800 GAMVAL←STRATEVAL(2,1-TTYGUY,0,35); SCRUPD;
33900 J←STRATEVAL(18,1-TTYGUY,0,19)+STRATEVAL(18,1-TTYGUY,30,31);
34000 IIIDPY←IIISAV; STOPHI←-200000; STOPLO←200000;
34100 FOR I←1 STEP 1 UNTIL 15 DO SCRFRV[I]←SCRENV[I];
34200 FOR I←1 STEP 1 UNTIL 15 DO BEGIN
34300 IF XGB3[CURPNT←SCRENV[I]]≠-1 THEN BEGIN
34400 CURI←CURPNT DIV 21; CURJ←CURPNT MOD 21;
34500 II←LEGAL(CURI,CURJ,1-TTYGUY); DANGERSTONES←NODANS;
34600 IF II←NGHBOR(XGB1[CURPNT] LAND '177) THEN BEGIN
34700 LABEL EXPNGH;
34800 IF EXMOVE∧((EXMOV1←LEGAL(EXMOVE DIV 21,
34900 EXMOVE MOD 21,TTYGUY))=0) THEN BEGIN
35000 II←XGB1[EXMOVE] LAND '177;
35100 FOR IJ←0 STEP 1 UNTIL 100 DO BEGIN
35200 IF MSGDPY[IJ]=II THEN DONE;
35300 IF MSGDPY[IJ]=0 THEN BEGIN
35400 MSGDPY[IJ]←II; MSGDPY[IJ+1]←0; DONE;
35500 END;
35600 END;
35700 END;
35800 IIIDPY←II←0;
35900 IF (OUTPON LAND '44000)∧(MSGDPY[0]∨BRDDPY[0]) THEN BEGIN
36000 OUT(LSTO,(IF OUTPOF THEN FF ELSE CRLF3));
36100 OUT(LSTO,"LADDERS FROM");
36200 OUT(LSTO,BLIJ(CURI,CURJ)); OUT(LSTO,TAB);
36300 OUT(LSTO,CVS(CALL(0,"RUNTIM"))); OUT(LSTO,CRLF&CRLF);
36400 END;
36500 EXPNGH: II←II+LADEVAL(0,MSCVAL[35],MSGDPY)
36600 +LADEVAL(9,MSCVAL[34],BRDDPY);
36700 IF NGHBR1 THEN GO TO EXPNGH;
36800 IIIDPY←IIISAV;
36900 END;
37000 KWIKAR; KWIKWL; KWAREA;
37100 UNMOVE; IF EXMOVE∧(EXMOV1=0) THEN UNMOVE;
37200 K←GBEGET(CURPNT)+STRATEVAL(18,1-TTYGUY,0,19)+
37300 STRATEVAL(18,1-TTYGUY,30,31)-J+II;
37400 GBFPUT(K,SCRFRV[I]);
37500 IF K>STOPHI THEN STOPHI←K;
37600 IF ((GBEGET(CURPNT)-K)<MSCVAL[33])∧(STOPLO>K) THEN STOPLO←K;
37700 IF (STOPHI-STOPLO)>MSCVAL[33] THEN DONE;
37800 END;
37900 END;
38000 J←14; K←1;
38100 WHILE K DO BEGIN
38200 K←0;
38300 FOR I←1 STEP 1 UNTIL J DO
38400 IF GBFGET(SCRFRV[I])<GBFGET(SCRFRV[I+1]) THEN BEGIN
38500 SCRFRV[I]↔SCRFRV[I+1]; K←1;
38600 END;
38700 J←J-1;
38800 END;
38900 MOVETIME←CALL(0,"RUNTIM")-MOVETIME;
39000 END;
39100
39200
39300
39400
39500
39600 INTERNAL PROCEDURE EVAL;
39700 BEGIN
39800 IF OUTPON LAND '4000 THEN OUT(LSTO,FF);
39900 UPDAT;
40000 IF OUTPON LAND '10000 THEN BRDOUT;
40100 IF OUTPON LAND '20000 THEN VALOUT(15);
40200 END;
40300
40400
40500
40600
40700 END "GOEVAL"